unit bwClasses;

interface

uses Windows, classes;

type
  TBwMs = class(TMemoryStream)
  public
    property capacity;
    function Write(const Buffer; Count: Longint): Longint;override;
  end;

implementation

{$IFDEF ver150} // d7
{$DEFINE USEQUICKSIZE}
{$ENDIF}
{$IFDEF ver130} // d5
{$DEFINE USEQUICKSIZE}
{$ENDIF}
function TBwMs.Write(const Buffer; Count: Longint): Longint;
var
  fsize : integer;
begin
  Result := inherited write(buffer, count);
  {$IFDEF USEQUICKSIZE}
  fsize := pinteger(pchar(@memory) + 4)^;
  {$ELSE}
  fsize := size;
  {$ENDIF}
  if Capacity = fsize then  // fsize = pinteger(pinteger(@memory) + 1)^
    Capacity := fsize * 2;
end;

end.

// test code
procedure TForm1.log(s: string);
begin
  mmtest.Lines.Add(s);
end;

procedure TForm1.TestCount(max : integer; testms : Boolean = true);
var
  ms : TMemoryStream;
  bs : TMemoryStream;//TBwMs;
  i : integer;
  start : TDatetime;
begin
  if testms then
  begin
    ms := TMemoryStream.create;
    start := now;
    for i := 1 to max do
    begin
      ms.Write(i, sizeof(i));
    end;
    start := Now- start;
    log('ms(' + inttostr(max) + '|' + inttostr(Tbwms(ms).Capacity) + '):' + FormatDateTime('ss:zzz', (start)));
    ms.free;
  end;
  bs := TBwMs.create;
  start := now;
  for i := 1 to max do
  begin
    bs.Write(i, sizeof(i));
  end;
  start := Now- start;
  log('bs(' + inttostr(max) + '|' + inttostr(Tbwms(bs).Capacity) + '):' + FormatDateTime('ss:zzz', (start)));
  bs.Free;
end;

procedure TForm1.btnTestClick(Sender: TObject);
begin
  TestCount (1000);
  TestCount (10000);
  TestCount (100000);
  TestCount (1000000);
  TestCount (2000000);
  TestCount (10000000, false);
end;

(*
test result
ms(1000|8192):00:000               1x
bs(1000|8192):00:000
ms(10000|40960):00:010             1x
bs(10000|65536):00:000
ms(100000|401408):00:060           2x
bs(100000|524288):00:030
ms(1000000|4005888):04:196         20x
bs(1000000|4194304):00:280
ms(2000000|8003584):16:714         28x
bs(2000000|8388608):00:621
bs(10000000|67108864):03:055

*)